      SUBROUTINE DISREG(A,NA,B,NB,H,NH,Q,NQ,R,NR,F,NF,P,NP,IOP,IDENT,DU
     1MMY)
C
C   PURPOSE:
C      Solve the time-invariant discrete-time linear optimal output
C      regulator problem with noise-free measurements.
C
C   REFERENCES:
C      Astrom, Karl J.: Introduction to Stochastic Control Theory.
C        Academic Press, Inc., 1970.
C
C   Subroutines employed by DISREG: ADD, DSICO, DSISL, EQUATE, LNCNT,
C      MAXEL, MULT, PRNT, SUBT, TRANP
C   Subroutines employing DISREG: ASYREG
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION A(1),B(1),Q(1),R(1),F(1),P(1),DUMMY(1)
      DIMENSION NA(2),NB(2),NQ(2),NR(2),NF(2),NP(2)
      DIMENSION IOP(3)
      DIMENSION H(1),NH(2),NDUM(2)
      LOGICAL  IDENT
      COMMON/TOL/EPSAM,EPSBM,IACM
      COMMON/CONV/SUMCV,MAXSUM,RICTCV,SERCV
C
      N = NA(1)**2
      N1= N +1
      N2= N1+N
      N3= N2+N
C
      KSS = 0
      I=IOP(3)
C
      IF(IOP(1) .EQ. 0)  GO TO 85
      CALL LNCNT(5)
      WRITE(6,25)
   25 FORMAT(//' PROGRAM TO SOLVE THE TIME-INVARIANT FINITE-DURATION OPT
     1IMAL'/' DIGITAL REGULATOR PROBLEM WITH NOISE-FREE MEASUREMENTS'/)
      CALL PRNT(A,NA,' A  ',1)
      CALL PRNT(B,NB,' B  ',1)
      CALL PRNT(Q,NQ,' Q  ',1)
      IF( .NOT. IDENT )  GO TO 45
      CALL LNCNT(3)
      WRITE(6,35)
   35 FORMAT(/' H IS AN IDENTITY MATRIX'/)
      GO TO 65
   45 CONTINUE
      CALL PRNT(H,NH,' H  ',1)
      CALL MULT(Q,NQ,H,NH,DUMMY,NH)
      CALL TRANP(H,NH,DUMMY(N1),NF)
      CALL MULT(DUMMY(N1),NF,DUMMY,NH,Q,NQ)
      CALL LNCNT(3)
      WRITE(6,55)
   55 FORMAT(/' MATRIX ( H TRANSPOSE )QH'/)
      CALL PRNT(Q,NQ,'HTQH',1)
   65 CONTINUE
      CALL PRNT(R,NR,' R  ',1)
      CALL LNCNT(4)
      WRITE(6,75)
   75 FORMAT(//' WEIGHTING ON TERMINAL VALUE OF STATE VECTOR'/)
      CALL PRNT(P,NP,' P  ',1)
C
   85 CONTINUE
      IF((IOP(1) .NE. 0)  .OR. IDENT)  GO TO 100
      CALL MULT(Q,NQ,H,NH,DUMMY,NH)
      CALL TRANP(H,NH,DUMMY(N1),NF)
      CALL MULT(DUMMY(N1),NF,DUMMY,NH,Q,NQ)
C
  100 CONTINUE
      I=I-1
      CALL EQUATE(P,NP,DUMMY,NP)
      CALL MULT(P,NP,A,NA,DUMMY(N1),NA)
      CALL TRANP(B,NB,DUMMY(N2),NF)
      CALL MULT(DUMMY(N2),NF,DUMMY(N1),NA,F,NF)
      CALL MULT(P,NP,B,NB,DUMMY(N1),NB)
      CALL MULT(DUMMY(N2),NF,DUMMY(N1),NB,DUMMY(N3),NR)
      CALL ADD(R,NR,DUMMY(N3),NR,DUMMY(N1),NR)
      IOPT = 3
      IAC=IACM
      MF = NR(1)
C
C   * * *  CALL TO MATHLIB FUNCTIONS * * *
      CALL DSICO(DUMMY(N1),MF,MF,DUMMY(N2),RCOND,DUMMY(N3))
      IF ((1.0 + RCOND) .NE. 1.0) GO TO 300
      CALL LNCNT(5)
      WRITE(6,200) I,RCOND
  200 FORMAT(//' IN DISREG, THE MATRIX R + B(TRANS)*P(',I2,')*B IS SIN',
     1 'GULAR TO WORKING PRECISION, RCOND = ',D16.8)
      RETURN
C
  300 CONTINUE
      NT = 1
      DO 325 M1 = 1,NF(2)
         CALL DSISL(DUMMY(N1),MF,MF,DUMMY(N2),F(NT))
         NT = NT + MF
  325 CONTINUE
      CALL MULT(R,NR,F,NF,DUMMY(N1),NF)
      CALL TRANP(F,NF,DUMMY(N2),NB)
      CALL MULT(DUMMY(N2),NB,DUMMY(N1),NF,P,NP)
      CALL ADD(Q,NQ,P,NP,P,NP)
      CALL MULT(B,NB,F,NF,DUMMY(N1),NA)
      CALL SUBT(A,NA,DUMMY(N1),NA,DUMMY(N1),NA)
      CALL MULT(DUMMY,NA,DUMMY(N1),NA,DUMMY(N2),NA)
      CALL TRANP(DUMMY(N1),NA,DUMMY(N3),NA)
      CALL MULT(DUMMY(N3),NA,DUMMY(N2),NA,DUMMY(N1),NA)
      CALL ADD(P,NP,DUMMY(N1),NA,P,NP)
C
      IF( IOP(2) .EQ. 0 )  GO TO 400
      CALL LNCNT(5)
      WRITE(6,350) I
  350 FORMAT(///' STAGE ',I5,/)
      CALL PRNT(F,NF,' F  ',1)
      CALL PRNT(P,NP,' P  ',1)
C
  400 CONTINUE
      IF( I .EQ. 0 )  GO TO 600
      CALL MAXEL(DUMMY,NP,ANORM1)
      CALL SUBT(DUMMY,NP,P,NP,DUMMY(N2),NP)
      CALL MAXEL(DUMMY(N2),NP,ANORM2)
      IF( ANORM1 .NE. 0.0 )  GO TO 500
      GO TO 100
C
  500 CONTINUE
      IF(ANORM1 .GT. 1.0 ) GO TO 550
      IF( ANORM2/ANORM1 .LT. RICTCV ) KSS = 1
      GO TO 575
  550 CONTINUE
      IF( ANORM2 .LT. RICTCV ) KSS=1
  575 CONTINUE
      IF( KSS .EQ. 1) GO TO 600
      GO TO 100
C
  600 CONTINUE
      K = IOP(1) + IOP(2)
      IF( K .EQ. 0 ) RETURN
      IF( KSS .EQ. 0) GO TO 700
      CALL LNCNT(4)
      WRITE(6,650)
  650 FORMAT(//' STEADY-STATE SOLUTION HAS BEEN REACHED IN  DISREG'/)
C
  700 CONTINUE
      IF( IOP(2) .NE. 0 )  RETURN
      IF( IOP(1) .EQ. 0 )  RETURN
      CALL LNCNT(3)
      I = IOP(3)-I
      WRITE(6,800) I
  800 FORMAT(/' F AND P AFTER ',I5 ,' STEPS'/)
      CALL PRNT(F,NF,' F  ',1)
      CALL PRNT(P,NP,' P  ',1)
C
      RETURN
      END
